home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1994 December / PSL Monthly Shareware CD-ROM (Public Software Library)(December 1994).bin / prgmming / win / vb1 / minifile.bas < prev    next >
BASIC Source File  |  1992-11-25  |  4KB  |  115 lines
  1. '***************************************************************************
  2. '** MINIFILE.BAS
  3. '***************
  4. '** VB Module for simplifying .INI file operations
  5. '**
  6. '** Usage:
  7. '** --------
  8. '** Either use ReadIni and SaveIni ad-hoc, or record the application name
  9. '** and INI file name using MINIFILERegister and call
  10. '** [Get|Put]Profile[String|Int] as necessary.
  11. '**
  12. '***************************************************************************
  13.  
  14. '** Windows API calls
  15.  
  16. Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  17. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  18. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
  19.  
  20. '** Redefine WPPS() to allow a NULL pointer (instead of a pointer to a NULL string...
  21. Declare Function WriteNullPrivateProfileString Lib "Kernel" Alias "WritePrivateProfileString" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpStrPtr As Long, ByVal lpFileName As String) As Integer
  22.  
  23. '***************************************************************************
  24.  
  25. '** Module-level variables for application and .INI file names
  26. '** (maintained by MINIFILERegister)
  27.  
  28. Dim smAppName As String
  29. Dim smIniFile As String
  30.  
  31. Sub ClearProfileString (sKeyName As String)
  32.  
  33. '**************************************************************************
  34. '** Use this sub to set the value of a key to NULL (blank, or whatever).
  35. '** Use DeleteProfileKey(KeyName) to remove the entry altogether.
  36. '**************************************************************************
  37.  
  38. x% = WritePrivateProfileString(smAppName, sKeyName, "", smIniFile)
  39.  
  40. End Sub
  41.  
  42. Sub DeleteProfileKey (sKeyName As String)
  43.  
  44. '***********************************************************************
  45. '** When a null pointer (rather than a pointer to null - see ClearProfileString)
  46. '** is passed to WritePrivateProfileString(), the whole line in the INI file
  47. '** is removeed.
  48. '***********************************************************************
  49.  
  50. x% = WriteNullPrivateProfileString(smAppName, sKeyName, 0, smIniFile)
  51.  
  52. End Sub
  53.  
  54. Function GetProfileInt (sKeyName As String, nDefaultValue As Integer) As Integer
  55.  
  56. GetProfileInt = GetPrivateProfileInt(smAppName, sKeyName, nDefaultValue, smIniFile)
  57.  
  58. End Function
  59.  
  60. Function GetProfileString (sKeyName As String, sDefaultValue As String) As String
  61.  
  62. Dim sTemp As String * 255
  63. Dim nLen As Integer
  64. Dim nRet As Integer
  65.  
  66. nLen = 255
  67. nRet = GetPrivateProfileString(smAppName, sKeyName, sDefaultValue, sTemp, nLen, smIniFile)
  68. GetProfileString = Left$(sTemp, nRet)
  69.  
  70. End Function
  71.  
  72. Sub MINIFILERegister (sAppName As String, sIniFileName As String)
  73.  
  74. smAppName = sAppName
  75. smIniFile = sIniFileName
  76.  
  77. End Sub
  78.  
  79. Function PutProfileInt (sKeyName As String, ByVal nValue As Integer) As Integer
  80.  
  81. PutProfileInt = WritePrivateProfileString(smAppName, sKeyName, Str$(nValue), smIniFile)
  82.  
  83. End Function
  84.  
  85. Function PutProfileString (sKeyName As String, ByVal sValue As String) As Integer
  86.  
  87. PutProfileString = WritePrivateProfileString(smAppName, sKeyName, sValue, smIniFile)
  88.  
  89. End Function
  90.  
  91. Sub ReadIni (AppName$, KeyName$, nDefault, DefaultStr$, ReturnStr$, Numeric%, IniFileName$)
  92.  
  93. If Numeric% Then    'we are looking for integer input
  94.   Numeric% = GetPrivateProfileInt(AppName$, KeyName$, nDefault, IniFileName$)
  95. Else
  96.   Dim RetStr As String * 255 'Create an empty string to be filled
  97.   nSize% = 255               'uncertain - possibly length of fill string
  98.   lenRetString% = GetPrivateProfileString(AppName$, KeyName$, DefaultStr$, RetStr$, nSize%, IniFileName$)
  99.   ReturnStr$ = Left$(RetStr$, lenRetString%)
  100. End If
  101.  
  102. End Sub
  103.  
  104. Sub SaveIni (AppName$, IniFileName$, KeyName$, NewVal$)
  105.     
  106. ' Update INI file
  107.         
  108. ResultCode% = WritePrivateProfileString(AppName$, KeyName$, NewVal$, IniFileName$)
  109. If ResultCode% = 0 Then
  110.   MsgBox "Error updating INI file!", 16, "ERROR!"
  111. End If
  112.     
  113. End Sub
  114.  
  115.